home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / euphoria / mset.ex < prev    next >
Text File  |  1994-03-02  |  10KB  |  380 lines

  1.         ---------------------------------
  2.         -- Plotting the Mandelbrot Set --
  3.         ---------------------------------
  4. -- Usage: ex mset [filename.dat]
  5. -- e.g. ex mset msetb
  6.  
  7. -- Either generate the initial picture, or redisplay an old one.
  8. -- Hit Enter at any time to stop the display and then hit Enter again 
  9. -- to display a grid. Use the arrow keys to select the most interesting 
  10. -- box in the grid. Hit Enter to enlarge this box to the full size of 
  11. -- the screen, or hit q to quit. The pictures that you display are saved in
  12. -- mseta.dat, msetb.dat, ... You can redisplay them and then put up the 
  13. -- grid and continue zooming in. As you zoom in, black areas are eroded 
  14. -- around the edges, as the iteration count is increased, and we find that
  15. -- points originally believed to be members of the Mset are not members 
  16. -- after all.
  17.  
  18. without type_check
  19.  
  20. include graphics.e
  21. include select.e
  22. include get.e
  23.  
  24. constant GRAPHICS_MODE = 261 -- SVGA
  25.                  -- choose a good mode for your machine
  26.                  -- see euphoria\include\graphics.e
  27.  
  28. constant ZOOM_FACTOR = 20    -- grid size for zooming in
  29.  
  30. constant FALSE = 0, TRUE = 1
  31. constant REAL = 1, IMAG = 2
  32.  
  33. constant ARROW_LEFT  = 331,
  34.      ARROW_RIGHT = 333,
  35.      ARROW_UP    = 328,
  36.      ARROW_DOWN  = 336
  37.  
  38.     -- types --
  39.  
  40. type natural(integer x)
  41.     return x >= 0
  42. end type
  43.  
  44. type complex(sequence x)
  45.     return length(x) = 2 and atom(x[1]) and atom(x[2])
  46. end type
  47.  
  48. procedure beep()
  49. -- make a beep sound
  50.     atom t
  51.  
  52.     t = time()
  53.     sound(500)
  54.     while time() < t + .2 do
  55.     end while
  56.     sound(0)
  57. end procedure
  58.  
  59. natural ncolors
  60. integer max_color, min_color
  61.  
  62. object prev_mixture 
  63. prev_mixture = {0, 0, 0} -- color 0: black
  64.  
  65. procedure randomize_palette()
  66. -- choose random color mixtures    
  67.     for i = max_color to min_color by -1 do
  68.     prev_mixture = palette(i, rand(repeat(63, 3)))
  69.     end for
  70.     prev_mixture = palette(0, rand(repeat(63, 3)))
  71. end procedure
  72.  
  73. procedure rotate_palette()
  74. -- rotate the color mixtures of all the colors
  75.     
  76.     for i = max_color to min_color by -1 do
  77.     prev_mixture = palette(i, prev_mixture) 
  78.     if atom(prev_mixture) then
  79.         return -- didn't work
  80.     end if
  81.     end for
  82.     prev_mixture = palette(0, prev_mixture)
  83. end procedure
  84.  
  85. natural max_iter
  86.  
  87. sequence vc -- current video configuration
  88.  
  89. procedure grid(sequence x, sequence y, natural color)
  90. -- draw the grid
  91.     atom dx, dy
  92.  
  93.     dx = vc[VC_XPIXELS]/ZOOM_FACTOR
  94.     dy = vc[VC_YPIXELS]/ZOOM_FACTOR
  95.  
  96.     for i = x[1] to x[2] do
  97.     draw_line(color, {{i*dx, y[1]*dy}, {i*dx, y[2]*dy}})
  98.     end for
  99.     for i = y[1] to y[2] do
  100.     draw_line(color, {{x[1]*dx, i*dy}, {x[2]*dx, i*dy}})
  101.     end for
  102. end procedure
  103.  
  104. function zoom()
  105. -- select place to zoom in on next time
  106.     integer key
  107.     sequence box
  108.  
  109.     grid({0, ZOOM_FACTOR}, {0, ZOOM_FACTOR}, 7)
  110.     box = {0, ZOOM_FACTOR-1}
  111.     while TRUE do
  112.     grid({box[1], box[1]+1}, {box[2], box[2]+1}, 14)
  113.     key = get_key()
  114.     if key != -1 then
  115.         grid({box[1], box[1]+1}, {box[2], box[2]+1}, 7)
  116.         if key = ARROW_UP then
  117.         if box[2] > 0 then
  118.             box[2] = box[2]-1
  119.         end if
  120.         elsif key = ARROW_DOWN then
  121.         if box[2] < ZOOM_FACTOR-1 then
  122.             box[2] = box[2]+1
  123.         end if
  124.         elsif key = ARROW_RIGHT then
  125.         if box[1] < ZOOM_FACTOR-1 then
  126.             box[1] = box[1]+1
  127.         end if
  128.         elsif key = ARROW_LEFT then
  129.         if box[1] > 0 then
  130.             box[1] = box[1]-1
  131.         end if
  132.         elsif key = 'q' then
  133.         return {}  -- quit
  134.         else
  135.         return {box[1], ZOOM_FACTOR - 1  - box[2]}
  136.         end if
  137.     end if
  138.     end while
  139. end function
  140.  
  141. procedure save_points(integer file, integer rep_count, integer color)
  142. -- We do a bit of image compression here by recording the number of
  143. -- consecutive points of a certain color. Can have up to 256 colors.
  144.     while rep_count > 255 do
  145.     puts(file, 255)
  146.     puts(file, color)
  147.     rep_count = rep_count - 255
  148.     end while
  149.     if rep_count > 0 then
  150.     puts(file, rep_count)
  151.     puts(file, color)
  152.     end if
  153. end procedure
  154.  
  155. function mset(complex lower_left,  -- lower left corner
  156.           complex upper_right) -- upper right corner
  157. -- Plot the Mandelbrot set over some region.
  158. -- The Mandelbrot set is defined by the equation: z = z * z + C
  159. -- where z and C are complex numbers. The starting point for z is 0.
  160. -- If, for a given value of C, z approaches infinity, C is considered to
  161. -- *not* be a member of the set. It can be shown that if the absolute value
  162. -- of z ever becomes greater than 2, then the value of z will increase
  163. -- towards infinity from then on. After a large number of iterations, if
  164. -- the absolute value of z is still less than 2 then we assume with high
  165. -- probability that C is a member of the Mset and this program will show
  166. -- that point in black.
  167.     complex c
  168.     atom zr, zi, zr2, zi2, cr, ci, xsize, ysize
  169.     natural member, stop, color, rep_count, width, height
  170.     natural file_no
  171.     integer pic_save, prev_color
  172.  
  173.     clear_screen()
  174.     height = vc[VC_YPIXELS]
  175.     width = vc[VC_XPIXELS]
  176.     ncolors = vc[VC_NCOLORS]
  177.     xsize = (upper_right[REAL] - lower_left[REAL])/(width - 1)
  178.     ysize = (upper_right[IMAG] - lower_left[IMAG])/(height - 1)
  179.     c = {0, 0}
  180.  
  181.     -- choose a new file to save the picture into
  182.     file_no = 0
  183.     for i = 'a' to 'z' do
  184.     pic_save = open("mset" & i & ".dat", "rb")
  185.     if pic_save = -1 then
  186.         file_no = i
  187.         exit
  188.     else
  189.         -- file exists
  190.         close(pic_save)
  191.     end if
  192.     end for
  193.     if file_no then
  194.     pic_save = open("mset" & file_no & ".dat", "wb")
  195.     else
  196.     puts(1, "Couldn't find a new file name to use\n")
  197.     return 1
  198.     end if
  199.  
  200.     -- save graphics mode and max_iter
  201.     printf(pic_save, "%d ", vc[VC_MODE])
  202.     printf(pic_save, "%d ", max_iter)
  203.     -- save lower_left & upper_right as floating-point sequences
  204.     printf(pic_save, "{%20.15f,%20.15f}", lower_left)
  205.     printf(pic_save, "{%20.15f,%20.15f}", upper_right)
  206.     max_color = -1
  207.     min_color = 99999
  208.     for y = 0 to height - 1 do
  209.     if get_key() != -1 then
  210.         close(pic_save)
  211.         return 0
  212.     end if
  213.     c[IMAG] = upper_right[IMAG] - y * ysize
  214.     prev_color = -1 -- start fresh for each line
  215.     rep_count = 0
  216.     for x = 0 to width - 1 do
  217.         c[REAL] = lower_left[REAL] + x * xsize
  218.         member = TRUE
  219.         zr = 0
  220.         zi = 0
  221.         zr2 = 0
  222.         zi2 = 0
  223.         cr = c[REAL]
  224.         ci = c[IMAG]
  225.         for i = 1 to max_iter do
  226.         zi = 2 * zr * zi + ci
  227.         zr = zr2 - zi2 + cr
  228.         zr2 = zr * zr
  229.         zi2 = zi * zi
  230.         if zr2 + zi2 > 4 then
  231.             member = FALSE
  232.             stop = i
  233.             exit
  234.         end if
  235.         end for
  236.         if member = TRUE then
  237.         color = 0
  238.         else
  239.         color = stop + 51 -- gives nice sequence of colors
  240.         while color >= ncolors do
  241.             color = color - ncolors
  242.         end while
  243.         if color > max_color then
  244.             max_color = color
  245.         end if
  246.         if color < min_color then
  247.             min_color = color
  248.         end if
  249.         end if
  250.         pixel(color, {x, y}) -- also show non-member "bands"
  251.         if color = prev_color then
  252.         rep_count = rep_count + 1
  253.         else
  254.         save_points(pic_save, rep_count, prev_color)
  255.         rep_count = 1
  256.         prev_color = color
  257.         end if
  258.     end for
  259.     -- close off count at end of each line
  260.     save_points(pic_save, rep_count, color)
  261.     end for
  262.     beep()
  263.     close(pic_save)
  264.     return 0
  265. end function
  266.  
  267. procedure view(integer pic_save)
  268. -- redisplay a saved picture file
  269.     integer x, color, rep_count
  270.  
  271.     max_color = -1
  272.     min_color = 99999
  273.     for y = 0 to vc[VC_YPIXELS] - 1 do
  274.     x = 0
  275.     while x < vc[VC_XPIXELS] do
  276.         rep_count = getc(pic_save)
  277.         color = getc(pic_save)
  278.         if rep_count <= 0 then
  279.         return
  280.         end if
  281.         if rep_count = 1 then
  282.         pixel(color, {x, y})  -- faster
  283.         x = x + 1
  284.         else
  285.         draw_line(color, {{x, y}, {x+rep_count-1, y}})
  286.         x = x + rep_count
  287.         end if
  288.         if color != 0 then
  289.         if color > max_color then
  290.             max_color = color
  291.         end if
  292.         if color < min_color then
  293.             min_color = color
  294.         end if
  295.         end if
  296.     end while
  297.     end for
  298. end procedure
  299.  
  300. procedure Mandelbrot()
  301. -- main procedure
  302.     sequence delta, new_box
  303.     complex lower_left, upper_right
  304.     sequence cl, dataname, g
  305.     integer pic_save, mode
  306.  
  307.     cl = command_line()
  308.     if length(cl) >= 3 then
  309.     -- redisplay a saved picture
  310.     dataname = cl[3]
  311.     pic_save = open(dataname, "rb")
  312.     if pic_save = -1 then
  313.         if not find('.', dataname) then
  314.         dataname = dataname & ".dat"
  315.         pic_save = open(dataname, "rb")
  316.         end if
  317.         if pic_save = -1 then
  318.         puts(1, "Couldn't open " & dataname & '\n')
  319.         return
  320.         end if
  321.     end if
  322.     g = {}
  323.     for i = 1 to 4 do
  324.         g = g & get(pic_save)
  325.     end for
  326.     if g[1] != GET_SUCCESS or
  327.        g[3] != GET_SUCCESS or
  328.        g[5] != GET_SUCCESS or
  329.        g[7] != GET_SUCCESS then
  330.         puts(1, "Couldn't read " & dataname & '\n')
  331.         return
  332.     end if
  333.     mode = g[2]
  334.     max_iter = g[4]
  335.     lower_left = g[6]
  336.     upper_right = g[8]
  337.     if graphics_mode(mode) then
  338.     end if
  339.     vc = video_config()
  340.     view(pic_save)
  341.     else
  342.     -- initially show the upper half:
  343.     max_iter = 30 -- increases as we zoom in
  344.     lower_left = {-1, 0}
  345.     upper_right = {1, 1}
  346.     -- set up for desired graphics mode
  347.     if not select_mode(GRAPHICS_MODE) then
  348.         puts(2, "couldn't find a good graphics mode\n")
  349.         return
  350.     end if
  351.     vc = video_config()
  352.     if mset(lower_left, upper_right) then
  353.         return
  354.     end if
  355.     end if
  356.  
  357.     while TRUE do
  358.     while get_key() = -1 do
  359.             --rotate_palette()
  360.         randomize_palette()
  361.     end while
  362.     new_box = zoom()
  363.     if length(new_box) = 0 then
  364.         exit
  365.     end if
  366.     delta = (upper_right - lower_left)
  367.     lower_left = lower_left + new_box / ZOOM_FACTOR * delta
  368.     upper_right = lower_left + delta / ZOOM_FACTOR
  369.     max_iter = max_iter * 2  -- need more iterations as we zoom in
  370.     if mset(lower_left,  upper_right) then
  371.         exit
  372.     end if
  373.     end while
  374. end procedure
  375.  
  376. Mandelbrot()
  377.  
  378. if graphics_mode(-1) then
  379. end if
  380.